home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xlsym.c < prev    next >
Text File  |  1980-01-01  |  4KB  |  172 lines
  1. /* xlsym - symbol handling routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern NODE *oblist,*keylist;
  7. extern NODE *s_unbound;
  8. extern NODE *xlstack;
  9.  
  10. /* forward declarations */
  11. FORWARD NODE *symenter();
  12. FORWARD NODE *xlmakesym();
  13. FORWARD NODE *findprop();
  14.  
  15. /* xlenter - enter a symbol into the oblist or keylist */
  16. NODE *xlenter(name,type)
  17.   char *name;
  18. {
  19.     return (symenter(name,type,(*name == ':' ? keylist : oblist)));
  20. }
  21.  
  22. /* symenter - enter a symbol into a package */
  23. LOCAL NODE *symenter(name,type,listsym)
  24.   char *name; int type; NODE *listsym;
  25. {
  26.     NODE *oldstk,*lsym,*nsym,newsym;
  27.     int cmp;
  28.  
  29.     /* check for nil */
  30.     if (strcmp(name,"nil") == 0)
  31.     return (NIL);
  32.  
  33.     /* check for symbol already in table */
  34.     lsym = NIL;
  35.     nsym = listsym->n_symvalue;
  36.     while (nsym) {
  37.     if ((cmp = strcmp(name,xlsymname(car(nsym)))) <= 0)
  38.         break;
  39.     lsym = nsym;
  40.     nsym = cdr(nsym);
  41.     }
  42.  
  43.     /* check to see if we found it */
  44.     if (nsym && cmp == 0)
  45.     return (car(nsym));
  46.  
  47.     /* make a new symbol node and link it into the list */
  48.     oldstk = xlsave(&newsym,NULL);
  49.     newsym.n_ptr = newnode(LIST);
  50.     rplaca(newsym.n_ptr,xlmakesym(name,type));
  51.     rplacd(newsym.n_ptr,nsym);
  52.     if (lsym)
  53.     rplacd(lsym,newsym.n_ptr);
  54.     else
  55.     listsym->n_symvalue = newsym.n_ptr;
  56.     xlstack = oldstk;
  57.  
  58.     /* return the new symbol */
  59.     return (car(newsym.n_ptr));
  60. }
  61.  
  62. /* xlsenter - enter a symbol with a static print name */
  63. NODE *xlsenter(name)
  64.   char *name;
  65. {
  66.     return (xlenter(name,STATIC));
  67. }
  68.  
  69. /* xlmakesym - make a new symbol node */
  70. NODE *xlmakesym(name,type)
  71.   char *name;
  72. {
  73.     NODE *oldstk,sym,*str;
  74.  
  75.     /* create a new stack frame */
  76.     oldstk = xlsave(&sym,NULL);
  77.  
  78.     /* make a new symbol node */
  79.     sym.n_ptr = newnode(SYM);
  80.     sym.n_ptr->n_symvalue = (*name == ':' ? sym.n_ptr : s_unbound);
  81.     sym.n_ptr->n_symplist = newnode(LIST);
  82.     rplaca(sym.n_ptr->n_symplist,str = newnode(STR));
  83.     str->n_str = (type == DYNAMIC ? strsave(name) : name);
  84.     str->n_strtype = type;
  85.  
  86.     /* restore the previous stack frame */
  87.     xlstack = oldstk;
  88.  
  89.     /* return the new symbol node */
  90.     return (sym.n_ptr);
  91. }
  92.  
  93. /* xlsymname - return the print name of a symbol */
  94. char *xlsymname(sym)
  95.   NODE *sym;
  96. {
  97.     return (car(sym->n_symplist)->n_str);
  98. }
  99.  
  100. /* xlgetprop - get the value of a property */
  101. NODE *xlgetprop(sym,prp)
  102.   NODE *sym,*prp;
  103. {
  104.     NODE *p;
  105.  
  106.     return ((p = findprop(sym,prp)) ? car(p) : NIL);
  107. }
  108.  
  109. /* xlputprop - put a property value onto the property list */
  110. xlputprop(sym,val,prp)
  111.   NODE *sym,*val,*prp;
  112. {
  113.     NODE *oldstk,p,*pair;
  114.  
  115.     if ((pair = findprop(sym,prp)) == NIL) {
  116.     oldstk = xlsave(&p,NULL);
  117.     p.n_ptr = newnode(LIST);
  118.     rplaca(p.n_ptr,prp);
  119.     rplacd(p.n_ptr,pair = newnode(LIST));
  120.     rplaca(pair,val);
  121.     rplacd(pair,cdr(sym->n_symplist));
  122.     rplacd(sym->n_symplist,p.n_ptr);
  123.     xlstack = oldstk;
  124.     }
  125.     rplaca(pair,val);
  126. }
  127.  
  128. /* xlremprop - remove a property from a property list */
  129. xlremprop(sym,prp)
  130.   NODE *sym,*prp;
  131. {
  132.     NODE *last,*p;
  133.  
  134.     last = NIL;
  135.     for (p = cdr(sym->n_symplist); consp(p) && consp(cdr(p)); p = cdr(last)) {
  136.     if (car(p) == prp)
  137.         if (last)
  138.         rplacd(last,cdr(cdr(p)));
  139.         else
  140.         rplacd(sym->n_symplist,cdr(cdr(p)));
  141.     last = cdr(p);
  142.     }
  143. }
  144.  
  145. /* findprop - find a property pair */
  146. LOCAL NODE *findprop(sym,prp)
  147.   NODE *sym,*prp;
  148. {
  149.     NODE *p;
  150.  
  151.     for (p = cdr(sym->n_symplist); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  152.     if (car(p) == prp)
  153.         return (cdr(p));
  154.     return (NIL);
  155. }
  156.  
  157. /* xlsinit - symbol initialization routine */
  158. xlsinit()
  159. {
  160.     /* initialize the oblist */
  161.     oblist = xlmakesym("*oblist*",STATIC);
  162.     oblist->n_symvalue = newnode(LIST);
  163.     rplaca(oblist->n_symvalue,oblist);
  164.  
  165.     /* initialize the keyword list */
  166.     keylist = xlsenter("*keylist*");
  167.  
  168.     /* enter the unbound symbol indicator */
  169.     s_unbound = xlsenter("*unbound*");
  170.     s_unbound->n_symvalue = s_unbound;
  171. }
  172.